home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / acsol.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.7 KB  |  85 lines
  1.       subroutine acsol
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine solves the circuit equations by performing a forward
  5. c and backward substitution using the previously-computed lu factors.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=cirdat 3/15/83
  17.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  18.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  19. c spice version 2g.6  sccsid=blank 3/15/83
  20.       common /blank/ value(200000)
  21.       integer nodplc(64)
  22.       complex cvalue(32)
  23.       equivalence (value(1),nodplc(1),cvalue(1))
  24. c
  25. c  forward substitution
  26. c
  27.       do 20 i=2,nstop
  28.       loc=i
  29.       iord=nodplc(irswpf+i)
  30.    10 loc=nodplc(jcpt+loc)
  31.       if (nodplc(jcolno+loc).ge.i) go to 20
  32.       j=nodplc(jcolno+loc)
  33.       jord=nodplc(irswpf+j)
  34.       call cmult(value(lynl+loc),value(imynl+loc),
  35.      1     value(lvn+jord),value(imvn+jord),xreal,ximag)
  36.       value(lvn+iord)=value(lvn+iord)-xreal
  37.       value(imvn+iord)=value(imvn+iord)-ximag
  38.       go to 10
  39.    20 continue
  40. c
  41. c      back substitution
  42. c
  43.       i=nstop
  44.       iord=nodplc(irswpf+i)
  45.       jord=nodplc(icswpf+i)
  46.       locnn=indxx(iord,jord)
  47.    30 call cdiv(value(lvn+iord),value(imvn+iord),value(lynl+locnn),
  48.      1     value(imynl+locnn),value(lvn+iord),value(imvn+iord))
  49.       i=i-1
  50.       if (i.le.1) go to 60
  51.       iord=nodplc(irswpf+i)
  52.       loc=i
  53.    35 loc=nodplc(jcpt+loc)
  54.    40 if (nodplc(jcolno+loc).ne.i) go to 35
  55.       locnn=loc
  56.    50 loc=nodplc(jcpt+loc)
  57.       if (loc.eq.0) go to 30
  58.       j=nodplc(jcolno+loc)
  59.       jord=nodplc(irswpf+j)
  60.       call cmult(value(lynl+loc),value(imynl+loc),
  61.      1     value(lvn+jord),value(imvn+jord),xreal,ximag)
  62.       value(lvn+iord)=value(lvn+iord)-xreal
  63.       value(imvn+iord)=value(imvn+iord)-ximag
  64.       go to 50
  65. c
  66. c  reorder solution vector
  67. c
  68.    60 do 70 i=1,nstop
  69.       j=nodplc(icswpr+i)
  70.       k=nodplc(irswpf+j)
  71.       value(ndiag+i)=value(lvn+k)
  72.       value(ndiag+i+nstop)=value(imvn+k)
  73.    70 continue
  74.       call copy8(value(ndiag+1),value(lvn+1),nstop)
  75.       call copy8(value(ndiag+1+nstop),value(imvn+1),nstop)
  76.       do 120 i=2,nstop
  77.       cvalue(lcvn+i)=cmplx(sngl(value(lvn+i)),sngl(value(imvn+i)))
  78.   120 continue
  79.       cvalue(lcvn+1)=cmplx(0.0e0,0.0e0)
  80. c
  81. c  finished
  82. c
  83.       return
  84.       end
  85.